Global Morans'I = 0.146
Global Morans'I = 0.296
Global Morans'I = 0.025
From the LISA, we can ascertain that there was statistically significant low clustering in England
High entry rate seems to locate on the boundaries of England.
The LISA Cluser Map shows how the attribute entry rate clusters. The red color shows tracts where high rate cluster with high rates, and blue shows where low rates cluster with low rates. There is even a mix of high-low, for example the pink color. So, there is a cluster of high entry rate in the southwest commute area and clusters of lower ownership in the north.
In (1)
classic
spatial lag
spatial error
In (2)
classic
spatial lag
spatial error
# read geojson data7
# df_mg.to_csv(PATH + "/HHI_EnR_ttwa_England_for_R.csv")
import geopandas as gpd
import fiona
import sys
PATH = sys.path[0]
# export the geojson
gdf = gpd.read_file(PATH + "/Dataset/Spatial/HHI_EnR_ttwa_England_for_R.geojson")
3 figures will be needed
| 1998 | 2008 | 2018 | |
|---|---|---|---|
| Entry Rate | fig1_a | fig1_b | fig1_c |
| HHI | fig2_a | fig2_b | fig2_c |
| Performance | fig3_a | fig3_b | fig3_c |
raw_data contains ttwa, year, entry_rate, hh, assets
# environment prepare
library(tidyverse)
library(data.table)
library(sp)
library(sf)
library(table1)
library(tm)
library(spatstat)
library(here)
library(sp)
library(rgeos)
# library(maptools)
library(tmap)
library(sf)
library(geojson)
library(geojsonio)
library(tmaptools)
library(RColorBrewer)
library(spdep)
library(lubridate)
# read data in R
raw_data = read.csv(here::here("Dataset","df_hh_EnR_ttwaName_asset_not_drop.csv"))
# you can have a overview of this dataset
print("The number of rows is: ")
nrow(raw_data)
print("The number of columns is: ")
ncol(raw_data)
print("70 of all varriables are:")
head(names(raw_data),n = 70)
# import spatial dataset
eng_ttwa = st_read(here::here("Dataset","Spatial","eng_ttwa_boundary.geojson"))
# plot the map
plot(st_geometry(eng_ttwa))
dfm = merge(raw_data,eng_ttwa,by.x="ttwa_code",by.y="TTWA11CD",all = TRUE)
# calculate the density of tech firms in ttwa
# df merged & density is calculated
#dfm_den_cal = dfm %>%
# mutate(area=st_area(.))%>%
# mutate(density = firms*1000*1000/area)
#head(dfm_den_cal)
tmap_mode("plot")
# select year
df_1998 = raw_data %>% filter(year==1998)
df_2008 = raw_data %>% filter(year==2008)
df_2018 = raw_data %>% filter(year==2018)
df_2017_2018 = raw_data %>% filter(year==2017 | year==2018)
# merge
dfm_1998 = merge(eng_ttwa,df_1998,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2008 = merge(eng_ttwa,df_2008,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2018 = merge(eng_ttwa,df_2018,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2017_2018 = merge(eng_ttwa,df_2017_2018,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_all = merge(eng_ttwa,raw_data,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
# n/a -> 0
dfm_1998 = dfm_1998 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_2008 = dfm_2008 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_2018 = dfm_2018 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_2017_2018 = dfm_2017_2018 %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
dfm_all = dfm_all %>% replace_na(list(entry_rate=0,hh=0,average_assets=0))
cus_break = c(0,0.02,0.04,0.06,0.08,0.1,0.12,0.14,0.16,0.18,0.2,0.22,0.24,0.26,0.28,0.3,0.32,0.34,0.36,0.38,0.4)
df = dfm_2018
tm_shape(df) +
tm_polygons(col = "entry_rate",
legend.hist = TRUE,
title = "xx",
breaks = cus_break) +
tm_layout(legend.outside = TRUE) +
tm_borders()
build the break
summary(dfm_all$entry_rate)
summary(dfm_1998$entry_rate)
summary(dfm_2008$entry_rate)
summary(dfm_2018$entry_rate)
# cus_break = c(0,0.01,0.02,0.03,0.08,0.1,0.12,0.14,0.16,0.18,0.2,0.22,0.24,0.26,0.28,0.3,0.32,0.34,0.36,0.38,0.4)
# cus_break = c(0,0.04,0.08,0.12,0.16,0.2,0.24,0.28,0.32,0.36,0.4)
# cus_break = c(0,0.01,0.04,0.16,0.32,0.4)
# cus_break = c(0,0.001,0.005,0.01,0.03,0.05,0.10,0.15,0.2,0.4)
# cus_break = c(0,0.002457,0.018182,0.035029,0.048236,0.12153,0.14328,0.16108,0.32)
cus_break = c(0.00,0.007,0.01,0.013,0.03,0.035,0.077,0.12153,0.14,0.16,0.32)
# library(viridis)
# adjust with the colour
# tmaptools::palette_explorer()
dfm %>% info
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_1998
map_var = "entry_rate"
spatial_var = "ttwa"
legend_name = "Entry Rate (1998)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 1998"
enR_1998_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
breaks =c(50,100,150)
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuPu", n = 12,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
enR_1998_map
# tmap_arrange(enR_1998_map,tm_tmp1)
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
head(dfm)
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2008
map_var = "entry_rate"
spatial_var = "ttwa"
legend_name = "Entry Rate (2008)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 2008"
enR_2008_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuPu", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
enR_2008_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2018
map_var = "entry_rate"
spatial_var = "ttwa"
legend_name = "Entry Rate (2018)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 2018"
enR_2018_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.65, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuPu", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
enR_2018_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
enR_tmap = tmap_arrange(enR_1998_map,enR_2008_map,enR_2018_map,ncol = 1)
enR_tmap
# enR_tmap %>% tmap_save(.,here("Img","map_entry_rate_1998_to_2018.png"),dpi = 300)
enR_tmap %>% tmap_save(.,here("Img","map_entry_rate_1998_to_2018.png"),dpi = 300)
# animation
library(viridis)
library(gifski)
enR_animation <- tm_shape(dfm_all) +
tm_polygons(
col = "entry_rate",
style = "cont",
pal = "BuGn"
) +
tm_facets(along = "year") +
tm_layout(legend.position = c("left", "bottom"))
tmap_animation(
enR_animation, filename = "enR.gif",
delay = 50, width = 2400, height = 1200
)
nrow(dfm_all)
summary(dfm_all$hh)
# cus_break = c(0.002457,0.018182,0.035029,0.048236,0.072000,0.312686 )
cus_break = c(0,0.03968,0.07292,0.10000,0.15342,0.15625,1.00000)
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_1998
map_var = "hh"
spatial_var = "ttwa"
legend_name = " Herfindahl-Hirschman Index (1998)"
title_name = "The Distribution of the Herfindahl-Hirschman Index of the England Tech Clusters(ttwa) in 1998"
hhi_1998_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuGn", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
hhi_1998_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2008
map_var = "hh"
spatial_var = "ttwa"
legend_name = " Herfindahl-Hirschman Index (2008)"
title_name = "The Distribution of the Herfindahl-Hirschman Index of the England Tech Clusters(ttwa) in 2008"
hhi_2008_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
# tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuGn", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
hhi_2008_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2018
map_var = "hh"
spatial_var = "ttwa"
legend_name = " Herfindahl-Hirschman Index (2018)"
title_name = "The Distribution of the Herfindahl-Hirschman Index of the England Tech Clusters(ttwa) in 2018"
hhi_2018_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "BuGn", n = 7,
# pal = viridis(10, direction = -1),
breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
hhi_2018_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
hh_tmap = tmap_arrange(hhi_1998_map,hhi_2008_map,hhi_2018_map,ncol=1)
hh_tmap
# enR_tmap %>% tmap_save(.,here("Img","map_entry_rate_1998_to_2018.png"),dpi = 300)
hh_tmap %>% tmap_save(.,here("Img","map_hh_1998_to_2018.png"),dpi = 300)
df_1998 = raw_data %>% filter(year==1998)
df_2008 = raw_data %>% filter(year==2008)
df_2018 = raw_data %>% filter(year==2018)
df_2016 = raw_data %>% filter(year==2016)
df_2017 = raw_data %>% filter(year==2017)
df_2017_2018 = raw_data %>% filter(year==2017 | year==2018)
# merge
dfm_1998 = merge(eng_ttwa,df_1998,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2008 = merge(eng_ttwa,df_2008,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2018 = merge(eng_ttwa,df_2018,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2017 = merge(eng_ttwa,df_2017,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_2016 = merge(eng_ttwa,df_2016,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
dfm_all = merge(eng_ttwa,raw_data,by.x="TTWA11CD",by.y="ttwa_code",all.x = TRUE)
build the custom breaks
dfm_all$average_assets %>% summary()
dfm_1998$average_assets %>% summary()
dfm_2008$average_assets %>% summary()
raw_data %>%
filter(.,year==2014)%>%
summary()
cus_break = c(0,56900,58518,60194,91560,135434,141180,202891,263037,5307552,8532989,18578409)
# plot the figure: The distribution of the density of the London charge points in 2019
# Title: The distribution of the entry rate of the England tech clusters(ttwa) from 1998 to 2018
df = dfm_2016
map_var = "average_assets"
spatial_var = "ttwa"
legend_name = "Entry Rate (2018)"
title_name = "The Distribution of the Entry Rate of the England Tech Clusters(ttwa) in 2018"
l1 = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
# text.size = 0.8,
# size = 5.5,
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
# text.size = 1.5
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.65, .0085),fontface = "bold")+
tm_fill(col = map_var,
# style="jenks",
palette = "Blues", n = 7,
# pal = viridis(10, direction = -1),
# breaks = cus_break,
# popup.vars=c(spatial_var, map_var),
title=legend_name,
# title.size = 1.5,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = 1.2,
legend.hist.height = .25 )+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
l1
# assets_2018_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
head(dfm_all)
dfm3 = dfm_all %>%
mutate(area = st_area(geometry))%>%
mutate(area_km = units::set_units(area,km^2))%>%
mutate(density = firms / area_km)%>%
select(TTWA11CD,ttwa,year,entry_rate,hh,average_assets,density,firms,area_km)
# 输出dfm3
dfm3 %>% write_csv(here("Dataset","year_ttwa_enR_hh_den.csv"))
df = dfm1 %>% filter(year==2018)
map_var = "density"
legend_name = " Density(1/km^2)"
title_name = "The Distribution of The Density of the England Tech Clusters(ttwa) in 2018"
den_map = tm_shape( df )+
tm_compass( north = 0,
type = "4star",
show.labels = TRUE,
cardinal.directions = c("N", "E", "S", "W"),
lwd = 1,
position = c("left","center"),
bg.color = NA,
bg.alpha = NA,
just = NA)+
tm_scale_bar(position=c("left", "center"),
)+
tm_credits("Visualization by Zeqiang Fang",size=.6,position = c(.73, .0085),fontface = "bold")+
tm_fill(col = map_var,
palette = "BuGn", n = 20,
# breaks = cus_break,
title=legend_name,
legend.hist = TRUE,
legend.hist.position = c("left", "center")
)+
tm_layout(main.title = "",
main.title.size = .85,
frame=FALSE,
legend.outside =TRUE,
legend.hist.width = .85,
legend.hist.height = .25)+
tm_borders(col = "#D2D2D2", lwd = .5, lty = "solid", alpha = NA)
den_map
# enR_1998_map %>% tmap_save(here("Img","enR_1998.png"),dpi=300)
set a new coordsw
library(spdep)
df = dfm3%>%
st_transform(.,27700)
df %>% st_crs()
coordsW = df%>%
st_centroid()%>%
st_geometry()
plot(coordsW,axes=TRUE)
df %>% list(1)
df = df%>%
filter(year==2008)
group_by(TTWA11CD,year) %>%
summarise(
density = first(density),
ttwa = first(ttwa)
)
tm_shape(df) +
tm_polygons("density",
style="jenks",
palette="PuOr",
midpoint=NA,
# popup.vars=c("wardname", "density"),
title="Blue Plaque Density")
Eng_ttwa_nb <- df %>%
poly2nb(., queen=T)
Moran's I
https://en.wikipedia.org/wiki/Moran%27s_I
GWR
GWTR